      SUBROUTINE SETUP
      RETURN
      END
C   HS87
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS87'/
      DATA (X(I),I=1,6)
     F    /390.D0,1000.D0,419.5D0,340.5D0,198.175D0,.5D0/
      DATA N/ 6/ , NH/4/ , NG/12/
      DATA DEL0/0.04D0/ ,TAU0/1.00D0/ ,TAU/.1D0/
      DATA (GUNIT(1,J),J=5,16)/12*1/,(GUNIT(3,I),I=5,16)/6*1,6*-1/,
     F     (GUNIT(2,I),I=5,16)/1,2,3,4,5,6,
     F     1,2,3,4,5,6/
     F     ,((GUNIT(I,J),I=1,3),J=0,4)/-1,0,0,-1,0,0,-1,0,0,-1,0,0,
     F     -1,0,0/
      END
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),FX,F1,F2
      ICF=ICF+1
      F1=30.D0*X(1)
      IF ( X(1) .GE. 300.D0 ) F1=F1+X(1)
      F2=28.D0*X(2)
      IF ( X(2) .GE. 100.D0 ) F2=F2+X(2)
      IF ( X(2) .GE. 200.D0 ) F2=F2+X(2)
      FX=F1+F2
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADF(NX)
      ICGF=ICGF+1
      DO      100      I=3,6
      GRADF(I)=0.D0
  100 CONTINUE
      GRADF(1)=30.D0
      IF ( X(1) .GE. 300.D0 ) GRADF(1)=31.D0
      GRADF(2)=28.D0
      IF ( X(2) .GE. 100.D0 ) GRADF(2)=29.D0
      IF ( X(2) .GE. 200.D0 ) GRADF(2)=30.D0
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI,A,B,C,D,E,F
      DATA A/131.078D0/,B/1.48577D0/,C/.90798D0/,F/1.47588D0/
      CRES(I)=CRES(I)+1
      D=DCOS(F)
      E=DSIN(F)
      GOTO (100,200,300,400),I
  100 CONTINUE
      HXI=(300.D0-X(1)-X(3)/A*(X(4)*DCOS(B-X(6))-C*D*X(3)))
      RETURN
  200 CONTINUE
      HXI= (    -X(2)-X(4)/A*(X(3)*DCOS(B+X(6))-C*D*X(4)))
      RETURN
  300 CONTINUE
      HXI=(     -X(5)-X(4)/A*(X(3)*DSIN(B+X(6))-C*E*X(4)))
      RETURN
  400 CONTINUE
      HXI=(200.D0 -X(3)/A*(X(4)*DSIN(B-X(6))-C*E*X(3)))
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),GRADHI(NX),A,B,C,D,E,F
      SAVE A,B,C,F
      DATA A/131.078D0/,B/1.48577D0/,C/.90798D0/,F/1.47588D0/
      CGRES(I)=CGRES(I)+1
      D=DCOS(F)
      E=DSIN(F)
      DO      100      J=1,6
      GRADHI(J)=0.D0
 100  CONTINUE
      GOTO (200,300,400,500),I
  200 CONTINUE
      GRADHI(1)=-1.D0
      GRADHI(3)=(2.D0*C*D*X(3)-X(4)*DCOS(B-X(6)))/A
      GRADHI(4)=-X(3)*DCOS(B-X(6))/A
      GRADHI(6)=-X(3)*X(4)*DSIN(B-X(6))/A
      GOTO 600
  300 CONTINUE
      GRADHI(2)=-1.D0
      GRADHI(4)=(2.D0*C*D*X(4)-X(3)*DCOS(B+X(6)))/A
      GRADHI(3)=-X(4)*DCOS(B+X(6))/A
      GRADHI(6)=X(3)*X(4)*DSIN(B+X(6))/A
      GOTO 600
  400 CONTINUE
      GRADHI(5)=-1.D0
      GRADHI(4)=(2.D0*C*E*X(4)-X(3)*DSIN(B+X(6)))/A
      GRADHI(3)=-X(4)*DSIN(B+X(6))/A
      GRADHI(6)=-X(3)*X(4)*DCOS(B+X(6))/A
      GOTO 600
  500 CONTINUE
      GRADHI(3)=(2.D0*C*E*X(3)-X(4)*DSIN(B-X(6)))/A
      GRADHI(4)=-X(3)*DSIN(B-X(6))/A
      GRADHI(6)= X(3)*X(4)*DCOS(B-X(6))/A
 600  CONTINUE
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),UG(6),OG(6),GXI
      SAVE UG,OG
      DATA UG/2*0.D0,2*340.D0,-1000.D0,0.D0/,
     1     OG/400.D0,1000.D0,2*420.D0,1.D4,.5236D0/
      IF ( GUNIT(1,I+NH) .EQ. -1 ) CRES(I+NH)=CRES(I+NH)+1
      IF( I .GT. 6)      GOTO 100
      GXI=X(I)-UG(I)
      RETURN
  100 CONTINUE
      GXI=OG(I-6)-X(I-6)
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX) ,GRADGI(NX)
      DO      100      J=1,6
      GRADGI(J)=0.D0
  100 CONTINUE
      IF(I.GT. 6)      GOTO 200
      GRADGI(I)=1.D0
      RETURN
  200 CONTINUE
      GRADGI(I-6)=-1.D0
      RETURN
      END
